unit uLayout ;

interface

uses
   Graphics,
   Controls,
   Forms,
   Classes,
   Contnrs,
   FlatSB,
   Windows,
   Messages,
   Math,
   VirtualScrollBox,
   VirtualTrees,
   uBasic,
   uPlacement,
   uMouseHandler,
   SpTBXDkPanels,
   GDIPOBJ,
   GDIPAPI ;

type

   TMedaViewer = class ;
   TMedaPlace = class( TMedaAbstractPlace )
   private
      fParent : TMedaViewer ;
      fObjects : TObjectlist ;

      procedure SetParent( const Value : TMedaViewer ) ;
   protected
      procedure HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ; var aHitlist : TMedaViewlist ) ; virtual ;
      procedure PaintAt( aGraphics : TMedaGraphics ) ; virtual ;
   public
      function GetChild( index : integer ) : TMedaViewable ; override ;
      function GetChildCount : integer ; override ;
      function GetText( aColumn : integer ) : string ; override ;
      function GetIcon : TIconType ; override ;
      function GetColor : TGPColor ; override ;
      function CanEdit( aColumn : integer ) : boolean ; override ;
   public
      function Center( aRect : TGPRectF ) : TPoint ; override ;
   public
      constructor Create ;
      destructor Destroy ; override ;
      procedure Mark ; override ;

      property Parent : TMedaViewer read fParent write SetParent ;

      procedure Clear ; virtual ;
      procedure Add( aObject : TMedaView ) ; virtual ;
      procedure Remove( aObject : TMedaView ) ; virtual ;
      function InvalRect( aRect : TGPRectF ) : TGPRectF ; virtual ; abstract ;
      procedure Vaporize ; virtual ;
   end ;

   TMedaMouseState = ( msIdle, msBack, msRight, msDouble, msLink, msTool ) ;
   TMedaRatsPaint = procedure( aGraphics : TMedaGraphics ) of object ;

   TMedaViewer = class( TVirtScrollBox )
   private
      fMouseState : TMedaMouseState ;
      fMouseHandler : TMouseHandler ;
      fMove : TGPPointF ;
      fRats : TMedaRatsPaint ;
      fVST : TBaseVirtualTree ;

      function ToZoom( a : TGPRectF ) : TGPRectF ;
      function ToBase( a : TGPPointF ) : TGPPointF ;
      function CreateMouseHandler( aMouseFactory : TMouseFactory ; Shift : TShiftState ; aGrid : integer ) : TMouseHandler ;
      procedure SetRats( const Value : TMedaRatsPaint ) ;
   protected
      fName : string ;
      fNode : PVirtualNode ;
      fMouseFactory : TMouseFactory ;
      fGraphics : TMedaGraphics ;
      fGPBitmap : TGPBitmap ;
      fRectBM : TGPRectF ;
      fCurrentWidth : single ;
      fCurrentHeight : single ;
      fZoom : double ;
      fGrid : integer ;
      fDensity : integer ;

      fGridPen0 : TGPPen ;
      fGridPen1 : TGPPen ;
      fGridPen2 : TGPPen ;
      fBackBrush : TGPSolidBrush ;

      fHitlist : TMedaViewlist ;

      procedure CreateGraphics ; virtual ; abstract ;
      procedure FreeGraphics ; virtual ;

      procedure DrawBuffer ;

      function HitTest( aPoint : TGPPointF ) : TMedaViewList ; virtual ;
      procedure Paint ; override ;
      procedure WMPaint( var Msg : TWMPaint ) ; message WM_PAINT ;

      function DoMouseWheelDown( Shift : TShiftState ; MousePos : TPoint ) : Boolean ; override ;
      function DoMouseWheelUp( Shift : TShiftState ; MousePos : TPoint ) : Boolean ; override ;

      procedure SetCurrentHeight( const Value : single ) ;
      procedure SetCurrentWidth( const Value : single ) ;
   public
      function Center( aRect : TGPRectF ) : TPoint ; virtual ;
   public
      constructor Create( AOwner : TComponent ) ; override ;
      destructor Destroy ; override ;
      procedure RegisterTree( aVST : TBaseVirtualTree ) ; virtual ;
      property VST : TBaseVirtualTree read fVST ;

      procedure Remove( aObject : TMedaViewable ) ; virtual ;

      procedure Clear ; virtual ; abstract ;
      function InvalRect( aRect : TGPRectF ) : TGPRectF ; virtual ;
      property Name : string read fName ;

      procedure DropSheet( aSheet : TWinControl ) ;

      procedure MouseDown( Button : TMouseButton ; Shift : TShiftState ; X, Y : Integer ) ; override ;
      procedure MouseMove( Shift : TShiftState ; X, Y : Integer ) ; override ;
      procedure MouseUp( Button : TMouseButton ; Shift : TShiftState ; X, Y : Integer ) ; override ;

      procedure KeyDown( var Key : Word ; Shift : TShiftState ) ; override ;

      property Width : single read fCurrentWidth write SetCurrentWidth ;
      property Height : single read fCurrentHeight write SetCurrentHeight ;

      procedure ZoomIn ; virtual ;
      function CanZoomIn : boolean ; virtual ;
      procedure ZoomOut ; virtual ;
      function CanZoomOut : boolean ; virtual ;
      property Rats : TMedaRatsPaint read FRats write SetRats ;
   end ;

implementation

uses
   SysUtils,
   uMain ;

{ TMedaPlace }

procedure TMedaPlace.Add( aObject : TMedaView ) ;
begin
   fObjects.Add( aObject ) ;
   aObject.Viewer := Self ;
   Update ;
end ;

procedure TMedaPlace.Remove( aObject : TMedaView ) ;
begin
   aObject.Viewer := nil ;
   fObjects.Remove( aObject ) ;
   Update ;
end ;

function TMedaPlace.CanEdit( aColumn : integer ) : boolean ;
begin
   Result := False ;
end ;

procedure TMedaPlace.Clear ;
begin
   fObjects.Clear ;
end ;

constructor TMedaPlace.Create ;
begin
   inherited ;
   fObjects := TObjectlist.Create( False ) ;
end ;

destructor TMedaPlace.Destroy ;
var
   i                : integer ;
begin
   for i := fObjects.Count - 1 downto 0 do
      ( fObjects[ i ] as TMedaView ).Viewer := nil ;
   fObjects.Free ;
   inherited ;
end ;

function TMedaPlace.GetChildCount : integer ;
begin
   Result := fObjects.Count ;
end ;

function TMedaPlace.GetIcon : TIconType ;
begin
   Result := iconUnknown ;
end ;

function TMedaPlace.GetChild( index : integer ) : TMedaViewable ;
begin
   Result := TMedaViewable( TMedaView( fObjects[ index ] ) ) ;
end ;

function TMedaPlace.GetText( aColumn : integer ) : string ;
begin
   Result := '' ;
   case aColumn of
      0 : Result := GetName ;
      1 : Result := IntToStr( GetChildCount ) + ' items' ;
   end ;
end ;

procedure TMedaPlace.HitTest( aPoint : TGPPointF ; aGraphics : TMedaGraphics ; var aHitlist : TMedaViewlist ) ;
var
   i                : integer ;
begin
   aHitlist.Place := Self ;
   for i := fObjects.Count - 1 downto 0 do
      if assigned( fObjects[ i ] ) and TMedaView( fObjects[ i ] ).HitTest( aPoint, aGraphics ) then
         aHitlist.Add( TMedaView( fObjects[ i ] ) ) ;
end ;

procedure TMedaPlace.Mark ;
var
   i                : integer ;
begin
   inherited ;
   for i := 0 to fObjects.Count - 1 do
      if assigned( fObjects[ i ] ) then
         TMedaView( fObjects[ i ] ).Mark ;
end ;

procedure TMedaPlace.PaintAt( aGraphics : TMedaGraphics ) ;
var
   i                : integer ;
begin
   for i := 0 to fObjects.Count - 1 do
      if assigned( fObjects[ i ] ) then
         ( TMedaView( fObjects[ i ] ).PaintAt( aGraphics ) ) ;
end ;

function TMedaPlace.GetColor : TGPColor ;
begin
   Result := aclMedaPlace ;
end ;

procedure TMedaPlace.SetParent( const Value : TMedaViewer ) ;
begin
   fParent := Value ;
end ;

function TMedaPlace.Center( aRect : TGPRectF ) : TPoint ;
begin
   Result := Point( 0, 0 ) ;
   if assigned( fParent ) then
      Result := fParent.Center( aRect ) ;
end ;

procedure TMedaPlace.Vaporize ;
begin
   if assigned( fParent ) then
      fParent.Remove( Self ) ;
   Free ;
end ;

{ TMedaViewer }

constructor TMedaViewer.Create( AOwner : TComponent ) ;
begin
   inherited Create( AOwner ) ;
   fGraphics := nil ;
   fGPBitmap := nil ;
   DoubleBuffered := True ;
   fMouseFactory := nil ;
   fZoom := 1 ;
   fGrid := 1 ;
   fDensity := 1 ;
   fRats := nil ;
   fHitlist := TMedaViewList.Create ;
end ;

destructor TMedaViewer.Destroy ;
begin
   if assigned( fGridPen0 ) then
      fGridPen0.Free ;
   if assigned( fGridPen1 ) then
      fGridPen1.Free ;
   if assigned( fGridPen2 ) then
      fGridPen2.Free ;
   if assigned( fBackBrush ) then
      fBackBrush.Free ;
   if assigned( fMouseFactory ) then
      fMouseFactory.Free ;
   FreeGraphics ;
   fHitlist.Free ;
   inherited ;
end ;

procedure TMedaViewer.FreeGraphics ;
begin
   if assigned( fGraphics ) then
      FreeAndNil( fGraphics ) ;
end ;

procedure TMedaViewer.WMPaint( var Msg : TWMPaint ) ;
var
   DC               : HDC ;
   PS               : TPaintStruct ;
begin
   if Msg.DC <> 0 then
      inherited
   else begin
      DC := BeginPaint( WindowHandle, PS ) ;
      try
         Msg.DC := DC ;
         WMPaint( Msg ) ;
      finally
         EndPaint( WindowHandle, PS ) ;
      end ;
   end ;
end ;

function TMedaViewer.HitTest( aPoint : TGPPointF ) : TMedaViewList ;
begin
   fHitlist.Clear ;
   fGraphics.Offset := MakePoint( ScrollLeft, ScrollTop ) ;
   Result := fHitlist ;
end ;

procedure TMedaViewer.Paint ;
var
   aRect, iDest     : TRect ;
   iRect            : TGPRectF ;
   i, j             : integer ;
begin
   aRect := Rect( 0, 0, Round( ScrollWidth ), Round( ScrollHeight ) ) ;
   OffsetRect( aRect, -Round( ScrollLeft ), -Round( ScrollTop ) ) ;
   iDest := Canvas.ClipRect ;
   {if IntersectRect( iDest, aRect, iDest ) then}
   begin
      Canvas.Brush.Color := clGray ;
      fRectBM.X := iDest.Left ;
      fRectBM.Y := iDest.Top ;
      fRectBM.Width := iDest.Right - iDest.Left ;
      fRectBM.Height := iDest.Bottom - iDest.Top ;
      fGPBitmap := TGPBitmap.Create( iDest.Right - iDest.Left, iDest.Bottom - iDest.Top, fGraphics ) ;
      fGraphics.MemGraphics := fGraphics.FromImage( fGPBitmap ) ;
      with fGraphics do begin
         MemGraphics.SetSmoothingMode( SmoothingModeHighSpeed ) ;
         iRect := fRectBM ;
         iRect.X := 0 ;
         iRect.Y := 0 ;
         MemGraphics.FillRectangle( fBackbrush, iRect ) ;
         if fGrid * fZoom * fDensity > 1 then begin
            for i := 0 to Round( fCurrentHeight ) - 1 do begin
               j := Round( i * fGrid * fZoom - ScrollTop ) ;
               if fRectBM.Y <= j then begin
                  if j >= fRectBM.Y + fRectBM.Height then
                     Break ;
                  if ( fDensity = 1 ) or ( i mod fDensity = 0 ) then begin
                     if fGrid * fZoom * fDensity > 7 then begin
                        if i mod ( 10 * fDensity ) = 0 then
                           MemGraphics.DrawLine( fGridPen2, 0, j - fRectBM.Y, fRectBM.Width, j - fRectBM.Y )
                        else if i mod ( 5 * fDensity ) = 0 then
                           MemGraphics.DrawLine( fGridPen1, 0, j - fRectBM.Y, fRectBM.Width, j - fRectBM.Y )
                        else
                           MemGraphics.DrawLine( fGridPen0, 0, j - fRectBM.Y, fRectBM.Width, j - fRectBM.Y ) ;
                     end ;
                  end ;
               end ;
            end ;
            for i := 0 to Round( fCurrentWidth ) - 1 do begin
               j := Round( i * fGrid * fZoom - ScrollLeft ) ;
               if fRectBM.X <= j then begin
                  if j >= fRectBM.X + fRectBM.Width then
                     Break ;
                  if ( fDensity = 1 ) or ( i mod fDensity = 0 ) then begin
                     if fGrid * fZoom * fDensity > 7 then begin
                        if i mod ( 10 * fDensity ) = 0 then
                           MemGraphics.DrawLine( fGridPen2, j - fRectBM.X, 0, j - fRectBM.X, fRectBM.Height )
                        else if i mod ( 5 * fDensity ) = 0 then
                           MemGraphics.DrawLine( fGridPen1, j - fRectBM.X, 0, j - fRectBM.X, fRectBM.Height )
                        else
                           MemGraphics.DrawLine( fGridPen0, j - fRectBM.X, 0, j - fRectBM.X, fRectBM.Height ) ;
                     end ;
                  end ;
               end ;
            end ;
         end ;
         with MemGraphics do begin
            SetSmoothingMode( SmoothingModeHighQuality ) ;
            SetTextRenderingHint( TextRenderingHintAntiAlias ) ;
            SetCompositingMode( CompositingModeSourceOver ) ;
            SetCompositingQuality( CompositingQualityHighQuality ) ;

            //                SetSmoothingMode( SmoothingModeHighQuality ) ;
            //                SetTextRenderingHint( TextRenderingHintClearTypeGridFit ) ;
            //                SetCompositingQuality( CompositingQualityHighQuality ) ;

            iRect := fRectBM ;
            iRect.X := iRect.X + ScrollLeft ;
            iRect.Y := iRect.Y + ScrollTop ;
            fGraphics.Offset := MakePoint( iRect.X, iRect.Y ) ;
            iRect.X := iRect.X / fZoom ;
            iRect.Y := iRect.Y / fZoom ;
            iRect.Width := iRect.Width / fZoom ;
            iRect.Height := iRect.Height / fZoom ;
            fGraphics.View := iRect ;
         end ;
      end ;
   end ;
end ;

procedure TMedaViewer.RegisterTree( aVST : TBaseVirtualTree ) ;
begin
   fVST := aVST ;
end ;

procedure TMedaViewer.Remove(aObject: TMedaViewable);
begin
end;

procedure TMedaViewer.DrawBuffer ;
begin
   if assigned( fGPBitmap ) then begin
      fGraphics.DrawImage( fGPBitmap, fRectBM.X, fRectBM.Y ) ;
      fGraphics.MemGraphics.Free ;
      FreeAndNil( fGPBitmap ) ;
   end ;
end ;

procedure TMedaViewer.SetCurrentHeight( const Value : single ) ;
begin
   fCurrentHeight := Value ;
   SetScrollBounds( 0, 0, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
end ;

procedure TMedaViewer.SetCurrentWidth( const Value : single ) ;
begin
   fCurrentWidth := Value ;
   SetScrollBounds( 0, 0, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
end ;

function TMedaViewer.CanZoomIn : boolean ;
begin
   Result := fZoom < 5 * 5 ;
end ;

function TMedaViewer.CanZoomOut : boolean ;
begin
   Result := fZoom > 1 / 5 / 5 ;
end ;

function TMedaViewer.ToBase( a : TGPPointF ) : TGPPointF ;
begin
   a.X := a.X + ScrollLeft ;
   a.Y := a.Y + ScrollTop ;
   Result.X := a.X / fZoom ;
   Result.Y := a.Y / fZoom ;
end ;

function TMedaViewer.ToZoom( a : TGPRectF ) : TGPRectF ;
begin
   Result.X := a.X * fZoom ;
   Result.Y := a.Y * fZoom ;
   Result.Width := a.Width * fZoom ;
   Result.Height := a.Height * fZoom ;
   Result.X := Result.X - ScrollLeft ;
   Result.Y := Result.Y - ScrollTop ;
end ;

function TMedaViewer.InvalRect( aRect : TGPRectF ) : TGPRectF ;
var
   r                : TRect ;
begin
   Result := aRect ;
   GPInflateRect( Result, 4 * fGrid ) ;
   Result := ToZoom( Result ) ;
   r.Left := Round( Result.X ) ;
   r.Top := Round( Result.Y ) ;
   r.Right := Round( Result.X + Result.Width ) ;
   r.Bottom := Round( Result.Y + Result.Height ) ;
   try
      Windows.InvalidateRect( Handle, @r, True ) ;
   except
      on EInvalidOperation do
   else
      raise ;
   end ;
end ;

function TMedaViewer.CreateMouseHandler( aMouseFactory : TMouseFactory ; Shift : TShiftState ; aGrid : integer ) : TMouseHandler ;
begin
   Result := nil ;
   if ssLeft in Shift then begin
      if ( ssCtrl in Shift ) and ( ssShift in Shift ) then
         Result := aMouseFactory.CreateLinker( aGrid )
      else
         case frmMain.frmProjEDA.Tool of
            toolSelect : Result := aMouseFactory.CreateSelector( aGrid ) ;
            toolDraw : Result := aMouseFactory.CreateDrawer( aGrid ) ;
            toolDrag : Result := aMouseFactory.CreateDragger( aGrid ) ;
            toolConnect : Result := aMouseFactory.CreateConnector( aGrid ) ;
         end ;
   end
   else if ssRight in Shift then
      Result := aMouseFactory.CreateRight( aGrid ) ;
end ;

procedure TMedaViewer.KeyDown( var Key : Word ; Shift : TShiftState ) ;
begin
   if assigned( fMouseHandler ) then
      fMouseHandler.KeyDown( Key, Shift ) ;
end ;

procedure TMedaViewer.MouseDown( Button : TMouseButton ; Shift : TShiftState ; X, Y : Integer ) ;
var
   p                : TGPPointF ;
   iHitList         : TMedaViewList ;
   fx, fy           : single ;
begin
   SetFocus ;
   fx := X ;
   fy := Y ;
   p := ToBase( MakePoint( fx, fy ) ) ;
   iHitList := HitTest( p ) as TMedaViewList ;
   if assigned( fMouseHandler ) then
      fMouseHandler.Down( iHitList, Shift, p )
   else begin
      MouseCapture := False ;
      fMouseState := msIdle ;
      if assigned( iHitlist ) or ( ssRight in Shift ) then begin
         fMouseHandler := CreateMouseHandler( fMouseFactory, Shift, fGrid ) ; // TMouseDouble.Create( fGrid ) ;
         if assigned( fMouseHandler ) then begin
            MouseCapture := True ;
            fMouseHandler.Down( iHitList, Shift, p ) ;
            fMouseState := msTool ;
         end ;
      end
      else begin
         MouseCapture := True ;
         fMove := p ;
         fMouseState := msBack ;
         Screen.Cursor := ord( crHandOpen ) ;
      end ;
   end ;
end ;

procedure TMedaViewer.MouseMove( Shift : TShiftState ; X, Y : Integer ) ;
var
   ax, ay           : integer ;
   p                : TGPPointF ;
   fHitList         : TMedaViewList ;
   fx, fy           : single ;

   procedure CheckScroll ;
   begin
      // see if we have to scroll
      ax := 0 ;
      ay := 0 ;
      if X < ClientRect.Left then
         ax := X
      else if X > ClientRect.Right then
         ax := X - ClientRect.Right ;
      if Y < ClientRect.Top then
         ay := Y
      else if Y > ClientRect.Bottom then
         ay := Y - ClientRect.Bottom ;
      if ( ax <> 0 ) or ( ay <> 0 ) then
         ScrollBy( ax, ay ) ;
   end ;
begin
   SetFocus ;
   fx := X ;
   fy := Y ;
   p := ToBase( MakePoint( fx, fy ) ) ;
   frmMain.Mouse := p ;

   if MouseCapture then
      case fMouseState of
         msIdle : begin
               MouseCapture := False ;
            end ;
         msBack : begin
               p := ToBase( MakePoint( fx, fy ) ) ;
               p.X := p.X - fMove.X ;
               p.Y := p.Y - fMove.Y ;
               p.X := -Round( p.X * fZoom ) ;
               p.Y := -Round( p.Y * fZoom ) ;
               ScaleDown( p, fGrid ) ;
               ScaleUp( p, fGrid ) ;
               X := Round( p.X ) ;
               Y := Round( p.Y ) ;
               ScrollBy( X, Y ) ;
            end ;
         msTool :
            if assigned( fMouseHandler ) then begin
               fHitList := HitTest( p ) as TMedaViewList ;
               CheckScroll ;
               p := ToBase( MakePoint( fx, fy ) ) ;
               fMouseHandler.Move( fHitList, Shift, p ) ;
            end ;
      end ;
end ;

procedure TMedaViewer.MouseUp( Button : TMouseButton ; Shift : TShiftState ; X, Y : Integer ) ;
var
   p                : TGPPointF ;
   fHitList         : TMedaViewList ;
   fx, fy           : single ;
begin
   inherited ;
   if assigned( fMouseHandler ) then begin
      fx := X ;
      fy := Y ;
      p := ToBase( MakePoint( fx, fy ) ) ;
      fHitList := HitTest( p ) as TMedaViewList ;
      fMousehandler.Up( fHitList, Shift, p ) ;
      if not ( ( ssLeft in Shift ) or ( ssRight in Shift ) ) then begin
         FreeAndNil( fMouseHandler ) ;
         MouseCapture := False ;
         fMouseState := msIdle ;
         Invalidate ;
      end ;
   end
   else begin
      if fMouseState in [ msBack, msRight ] then
         Screen.Cursor := crDefault ;
      MouseCapture := False ;
      fMouseState := msIdle ;
      Invalidate ;
   end ;
end ;

procedure TMedaViewer.DropSheet( aSheet : TWinControl ) ;
begin
   Parent := aSheet ;
   if assigned( aSheet ) then begin
      SetScrollBounds( 0, 0, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
      Align := alClient ;
      BevelKind := bkNone ;
      BevelInner := bvNone ;
      BevelOuter := bvNone ;
      BorderStyle := bsNone ;
      BorderWidth := 0 ;
      DoubleBuffered := True ;
      Invalidate ;
   end
   else
      Clear ;
end ;

procedure TMedaViewer.ZoomIn ;
var
   x, y             : integer ;
begin
   if not CanZoomIn then
      Exit ;
   x := Round( ( ScrollLeft + ClientWidth div 2 ) / fZoom ) ;
   y := Round( ( ScrollTop + ClientHeight div 2 ) / fZoom ) ;
   fZoom := fZoom * 1.05 ;
   x := Round( x * fZoom ) - ClientWidth div 2 ;
   y := Round( y * fZoom ) - ClientHeight div 2 ;
   SetScrollBounds( x, y, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
   Invalidate ;
end ;

procedure TMedaViewer.ZoomOut ;
var
   x, y             : integer ;
begin
   if not CanZoomOut then
      Exit ;
   x := Round( ( ScrollLeft + ClientWidth div 2 ) / fZoom ) ;
   y := Round( ( ScrollTop + ClientHeight div 2 ) / fZoom ) ;
   fZoom := fZoom / 1.05 ;
   x := Round( x * fZoom ) - ClientWidth div 2 ;
   y := Round( y * fZoom ) - ClientHeight div 2 ;
   SetScrollBounds( x, y, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
   Invalidate ;
end ;

function TMedaViewer.DoMouseWheelUp( Shift : TShiftState ; MousePos : TPoint ) : Boolean ;
var
   x, y             : integer ;
begin
   Result := True ;
   if not CanZoomIn then
      Exit ;
   MousePos := ScreenToClient( MousePos ) ;
   x := Round( ( ScrollLeft + MousePos.X ) / fZoom ) ;
   y := Round( ( ScrollTop + MousePos.Y ) / fZoom ) ;
   fZoom := fZoom * 1.125 ;
   x := Round( x * fZoom ) - MousePos.X ;
   y := Round( y * fZoom ) - MousePos.Y ;
   SetScrollBounds( x, y, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
   Invalidate ;
end ;

function TMedaViewer.DoMouseWheelDown( Shift : TShiftState ; MousePos : TPoint ) : Boolean ;
var
   x, y             : integer ;
begin
   Result := True ;
   if not CanZoomOut then
      Exit ;
   MousePos := ScreenToClient( MousePos ) ;
   x := Round( ( ScrollLeft + MousePos.X ) / fZoom ) ;
   y := Round( ( ScrollTop + MousePos.Y ) / fZoom ) ;
   fZoom := fZoom / 1.125 ;
   x := Round( x * fZoom ) - MousePos.X ;
   y := Round( y * fZoom ) - MousePos.Y ;
   SetScrollBounds( x, y, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
   Invalidate ;
end ;

function TMedaViewer.Center( aRect : TGPRectF ) : TPoint ;
var
   pCenter, pScreen, pOffset : TPoint ;

   procedure DoFocus ;
   begin
      while not CanFocus do

   end ;
begin
   if CanFocus then
      SetFocus ;
   with aRect do
      pCenter := Point( Round( ( X + Width / 2 ) * fZoom ), Round( ( Y + Height / 2 ) * fZoom ) ) ;
   pScreen := Point( ClientWidth div 2, ClientHeight div 2 ) ;
   pOffset := Point( pCenter.X - pScreen.X, pCenter.Y - pScreen.Y ) ;
   Result := Point( max( 0, pOffset.X ), max( 0, pOffset.Y ) ) ;
   SetScrollBounds( Result.X, Result.Y, Round( fCurrentWidth * fZoom ), Round( fCurrentHeight * fZoom ) ) ;
   pScreen := Point( pScreen.X - Result.X + pOffset.X, pScreen.Y - Result.Y + pOffset.Y ) ;
   Result := ClientToScreen( pScreen ) ;
   Mouse.CursorPos := Result ;
   Invalidate ;
end ;

procedure TMedaViewer.SetRats( const Value : TMedaRatsPaint ) ;
begin
   fRats := Value ;
   Invalidate ;
end ;

end.

